(in-package #:experiment)

(defclass subsequence (state)
  ((children :initarg :children :accessor subsequence-children)
   (index :initform 0 :initarg :index :accessor subsequence-index :documentation "The index into CHILDREN that is the current state.")))


(defgeneric subsequence-count (subseq type &key start end)
  (:documentation "Return the total number of child states of the specified type in the range from START to END."))

(defvar *subsequence-length* nil
  "The length of children in the current subsequence.")

(defvar *subsequence-nth* nil
  "The subsequence's current child's position in the list of children.")

(defmethod subsequence-count ((state subsequence) type &key
                              (start 0)
                              (end (length (subsequence-children state))))
  (loop
     for i in (subseq (subsequence-children state) start end)
     count (typep i type)))

(defmethod state-init (experiment (state subsequence))
  (log experiment 'start :index (subsequence-index state)))

(defmethod state-clean-up (experiment (state subsequence))
  )

(defmethod state-run (experiment (state subsequence))
  (let ((*subsequence-length* (length (subsequence-children state))))
    (loop
       for i from (subsequence-index state)
       while (< i (length (subsequence-children state)))
       for s = (nth i (subsequence-children state)) do
       (setf (subsequence-index state) i)
       (handler-case
           (let ((*subsequence-nth* i))
             (state-run experiment s))
         (backward ()
           (if (> i 0)
               (decf i 2)
               (progn
                 (state-backward experiment state)
                 (setf i -1))))))))

(defmethod state-dump append (experiment (state subsequence))
  `(:index ,(subsequence-index state)
    :children ,(mapcar (lambda (s) (state-dump experiment s)) (subsequence-children state))))

(defmethod compile-state (experiment (state subsequence) args)
  ;; a heuristic to find out if args is a plist or using the old abreviated form.
  (if (every 'listp args)
      (make-instance (type-of state)
                     :parent experiment
                     :children (mapcar (lambda (x) (compile-state experiment (car x) (cdr x)))
                                       args))
      (let ((children (getf args :children))
            (copy (copy-list args)))
        (remf copy :children)
        (apply 'make-instance (type-of state)
               :parent experiment
               :children (mapcar (lambda (x) (compile-state experiment (car x) (cdr x)))
                                 children)
               copy))))

